home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Celestin Apprentice 7
/
Apprentice-Release7.iso
/
Source Code
/
Pascal
/
Applications
/
NIH Image 1.62b11
/
Macros
/
Plotting Macros
< prev
next >
Wrap
Text File
|
1996-06-10
|
24KB
|
970 lines
macro 'Plot Histogram';
var
max,scale:real;
i,margin,width,height:integer;
begin
SaveState;
Margin:=10;
width:=256;
height:=0.6*256;
Measure;
SetForegroundColor(255);
SetBackgroundColor(0);
SetLineWidth(1);
SetNewSize(width+2*margin,height+2*margin);
MakeNewWindow('Histogram');
MakeRoi(margin,margin-1,width,height+1);
DrawBoundary;
max:=0;
for i:=1 to 254 do
if histogram[i]> max then max:=histogram[i];
scale:=height/max;
for i:=1 to 254 do begin
MakeRoi(margin+i,margin,1,histogram[i]*scale);
SetForegroundColor(i);
fill;
end;
SelectAll;
FlipVertical;
KillRoi;
RestoreState;
end;
macro 'Stack Histogram';
var
max,scale:real;
i,margin,width,height:integer;
begin
SaveState;
Margin:=10;
width:=256;
height:=0.6*256;
Measure;
SetForegroundColor(255);
SetBackgroundColor(0);
SetLineWidth(1);
SetNewSize(width+2*margin,height+2*margin);
MakeNewWindow('Histogram');
MakeRoi(margin,margin-1,width,height+1);
DrawBoundary;
max:=0;
for i:=1 to 254 do
if histogram[i]> max then max:=histogram[i];
scale:=height/max;
for i:=1 to 254 do begin
MakeRoi(margin+i,margin,1,histogram[i]*scale);
SetForegroundColor(i);
fill;
end;
SelectAll;
FlipVertical;
KillRoi;
RestoreState;
end;
procedure DoColumnPlot(MaxCount: integer);
{Plots the User1 column in the Results table.}
var
xmin,xmax,ymin,ymax,i,xscale,yscale:real;
width,height,margin,pwidth,pheight:integer;
y,pbottom, barWidth, barLeft, barTop:integer;
sum:integer;
begin
SaveState;
margin:=40;
width:=500;
height:=300;
sum:=0;
ymin:=0;
ymax:=-999999;
for i:=1 to maxCount do
if rUser1[i]>ymax then ymax:=rUser1[i];
xmin:=1;
xmax:=maxCount;
SetNewSize(width,height);
SetForeground(255);
SetBackground(0);
MakeNewWindow('Histogram');
pwidth:=width-2*margin;
pheight:=height-2*margin;
pbottom:=margin+pheight;
xscale:=pwidth/xmax;
yscale:=pheight/(ymax-ymin);
barWidth:=round(pwidth/maxCount)+1;
SetForeground(255);
SetBackground(0);
SetLineWidth(1);
for i:=0 to maxCount-1 do begin
barLeft:=margin+i*xscale;
barTop:=pbottom-(rUser1[i+1]-ymin)*yscale;
MakeRoi(barLeft, barTop, barWidth, pBottom-barTop);
fill;
sum:=sum+(i+1)*rUser1[i+1];
end;
KillRoi;
MoveTo(margin,margin);
LineTo(margin,margin+pheight);
SetFont('Geneva');
SetFontSize(9);
SetText('Centered');
MoveTo(margin+4,margin+pheight+12);
writeln(xmin:1:2);
MoveTo(margin+pwidth,margin+pheight+12);
writeln(xmax:1:2);
SetText('Right Justified');
MoveTo(margin-2,margin+pheight-5);
writeln(ymin:1:2);
MoveTo(margin-2,margin);
writeln(ymax:1:2);
MoveTo(margin+pwidth/2-15, margin+pheight+12);
RestoreState;
ShowMessage('sum=',sum:1,'\ymax=',ymax:1);
end;
macro 'Plot Histogram Using Bins';
var
i, nBins, bin: integer;
ValuesPerBin, TotalArea: real;
n, lower, upper, nValues: integer;
first, last: integer;
begin
ResetCounter;
nBins:=GetNumber('Number of Bins (1-256)', 10);
SetUser1Label('%');
SetUser2Label('Area');
Measure;
TotalArea := rArea[rCount];
GetThreshold(lower, upper);
if (lower = 0) and (upper = 0) then
upper := 255;
nValues := upper - lower + 1;
n := 0;
for i := lower to upper do
n := n + histogram[i];
ValuesPerBin := nValues / nBins;
for bin := 1 to nBins do
rUser1[bin] := 0;
{for i := lower to upper do begin
bin := trunc((i - lower) / ValuesPerBin) + 1;
rUser1[bin] := rUser1[bin] + Histogram[i];
end;}
SaveState;
SetFont('Monaco');
SetFontSize(9);
NewTextWindow('Histogram Data', 280, 450);
writeln(' Bin Range Count Percent Area');
for bin := 1 to nBins do begin
first := lower + trunc((nValues * (bin - 1)) / nBins);
last := lower + trunc((nValues * bin) / nBins) -1 ;
for i := first to last do
rUser1[bin] := rUser1[bin] + Histogram[i];
writeln(bin:3, first:6, last:4, rUser1[bin]:8, (rUser1[bin] / n) * 100:8:2, TotalArea * rUser1[bin] / n:10:2);
end;
RestoreState;
for bin := 1 to nBins do
rUser1[bin] := (rUser1[bin] / n) * 100.0;
for bin := 1 to nBins do
rUser2[bin] := TotalArea * rUser1[bin] / 100;
SetCounter(nBins);
DoColumnPlot(nBins);
end;
procedure DrawPerimeter;
var
length1, length2: integer;
dx1, dx2, dy1, dy2: integer;
dxp1, dxp2, dyp1, dyp2: integer;
sumdx, sumdy, corners: integer;
corner: boolean;
perimeter: real;
begin
RedLUT[254] := 255;
GreenLUT[254] := 0;
BlueLUT[254] := 0;
SetForeground(254);
sumdx := 0.0;
sumdy := 0.0;
corners := 0;
dx1 := xCoordinates[1] - xCoordinates[nCoordinates];
dy1 := yCoordinates[1] - yCoordinates[nCoordinates];
length1 := abs(dx1) + abs(dy1);
dxp1 := dx1;
if dxp1 > 1 then dxp1 := 1;
if dxp1 < -1 then dxp1 := -1;
dyp1 := dy1;
if dyp1 > 1 then dyp1 := 1;
if dyp1 < -1 then dyp1 := -1;
corner := false;
for i := 1 to nCoordinates do begin
dx2 := xCoordinates[i+1] - xCoordinates[i];
dy2 := yCoordinates[i+1] - yCoordinates[i];
{showmessage(i, abs(dx1), abs(dy1)); wait(2);}
sumdx := sumdx + abs(dx1);
sumdy := sumdy + abs(dy1);
length2 := abs(dx2) + abs(dy2);
dxp2 := dx2;
if dxp2 > 1 then dxp2 := 1;
if dxp2 < -1 then dxp2 := -1;
dyp2 := dy2;
if dyp2 > 1 then dyp2 := 1;
if dyp2 < -1 then dyp2 := -1;
if (length1 > 1) or (not corner) then begin
MoveTo((xCoordinates[i]-dxp1)*scale+10, (yCoordinates[i]-dyp1)*scale+10);
LineTo((xCoordinates[i]+dxp2)*scale+10, (yCoordinates[i]+dyp2)*scale+10);
corner := true;
corners := corners + 1;
end else
corner := false;
dx1 := dx2;
dy1 := dy2;
dxp1 := dxp2;
dyp1 := dyp2;
length1 := length2;
end;
perimeter := sumdx + sumdy;
end;
procedure ShowPerimeter;
var
length1, length2: integer;
dx1, dx2, dy1, dy2: integer;
sumdx, sumdy, nCorners: integer;
corner: boolean;
perimeter: real;
begin
sumdx := 0.0;
sumdy := 0.0;
nCorners := 0;
dx1 := xCoordinates[1] - xCoordinates[nCoordinates];
dy1 := yCoordinates[1] - yCoordinates[nCoordinates];
length1 := abs(dx1) + abs(dy1);
corner := false;
for i := 1 to nCoordinates do begin
dx2 := xCoordinates[i+1] - xCoordinates[i];
dy2 := yCoordinates[i+1] - yCoordinates[i];
sumdx := sumdx + abs(dx1);
sumdy := sumdy + abs(dy1);
length2 := abs(dx2) + abs(dy2);
if (length1 > 1) or (not corner) then begin
corner := true;
nCorners := nCorners + 1;
end else
corner := false;
dx1 := dx2;
dy1 := dy2;
length1 := length2;
end;
perimeter := sumdx + sumdy;
MoveTo(width/3,height/3 + 40);
Writeln('perimeter1=', perimeter:1:2);
Writeln('perimeter2=', perimeter - nCorners * (2 - sqrt(2)):1:2);
Writeln('perimeter3=', perimeter*0.948 - nCorners * (2 - 1.34):1:2);
end;
procedure DrawX(x, y:integer);
begin
moveto(x+3, y+3);
lineto(x-3, y-3);
moveto(x+3, y-3);
lineto(x-3, y+3);
lineto(x, y);
end;
macro 'Plot XY Coordinates [X]';
{Plots the X-Y Coordinates of the current ROI.}
var
i,w,h,width,height:integer;
xbase,ybase,RoiWidth,RoiHeight:integer
x,y,scale,xmax,ymax:real
begin
RequiresVersion(1.48);
if nCoordinates=0 then begin
beep;
PutMessage('No X-Y Coordinates available.');
exit;
end;
GetRoi(xbase,ybase,RoiWidth,RoiHeight);
SaveState;
InvertY(false);
xmax:=0;
ymax:=0;
for i:=1 to nCoordinates do begin
x:=xCoordinates[i];
y:=yCoordinates[i];
if x>xmax then xmax:=x;
if y>ymax then ymax:=y;
end;
scale:=sqrt((300*300)/(xmax*ymax));
if (xmax*scale)>500 then scale:=500/xmax;
if (ymax*scale)>500 then scale:=500/ymax;
SetForegroundColor(255);
SetBackgroundColor(0);
SetNewSize(xmax*scale+20,ymax*scale+20);
MakeNewWindow('Outline');
MoveTo(xCoordinates[1]*scale+10,yCoordinates[1]*scale+10);
for i:=2 to nCoordinates do begin
LineTo(xCoordinates[i]*scale+10,yCoordinates[i]*scale+10);
if nCoordinates < 100 then
DrawX(xCoordinates[i]*scale+10,yCoordinates[i]*scale+10);
end;
SetFont('Helvetica');
SetFontSize(12);
SetText('No background, Left Justified');
GetPicSize(width,height);
MoveTo(width/3,height/3);
Writeln(nCoordinates:1,' coordinate pairs');
Writeln('Origin=',xbase:1,', ',ybase:1);
Writeln('xmax=',xmax:1, ', ymax=',ymax:1,);
{DrawPerimeter;}
{ShowPerimeter;}
RestoreState;
end;
procedure PlotProfile2(integrate:boolean);
var
xmin,xmax,ymin,ymax,i,xscale,yscale:real;
width,height,margin,pwidth,pheight:integer;
count:integer;
ppv:integer; {Pixels per Value}
begin
SaveState;
margin:=40;
width:=500;
height:=300;
GetPlotData(count,ppv,ymin,ymax);
if count=0 then begin
PutMessage('No plot data available.');
exit;
end;
if integrate then begin
ymin:=ymin*ppv;
ymax:=ymax*ppv;
end;
xmin:=0;
xmax:=count-1;
SetNewSize(width,height);
SetForeground(255);
SetBackground(0);
MakeNewWindow('Plot');
pwidth:=width-2*margin;
pheight:=height-2*margin;
xscale:=pwidth/(xmax-xmin);
yscale:=pheight/(ymax-ymin);
SetForeground(255);
SetBackground(0);
SetLineWidth(1);
MoveTo(margin,margin);
if integrate then for i:=0 to count-1 do
LineTo(margin+i*xscale,margin+(PlotData[i]*ppv-ymin)*yscale)
else for i:=0 to count-1 do
LineTo(margin+i*xscale,margin+(PlotData[i]-ymin)*yscale);
MakeRoi(margin,margin,pwidth+1,pheight+2);
MoveTo(margin,margin);
LineTo(margin+pwidth,margin);
MoveTo(margin,margin);
LineTo(margin,margin+pheight);
FlipVertical;
KillRoi;
SetFont('Geneva');
SetFontSize(9);
SetText('Centered');
MoveTo(margin+4,margin+pheight+12);
writeln(xmin:1:2);
MoveTo(margin+pwidth,margin+pheight+12);
writeln(xmax:1:2);
SetText('Right Justified');
MoveTo(margin-2,margin+pheight-5);
writeln(ymin:1:2);
MoveTo(margin-2,margin);
writeln(ymax:1:2);
RestoreState;
end;
macro 'Plot Profile';
begin
PlotProfile2(false);
end;
macro 'Plot Integrated Profile';
begin
PlotProfile2(true);
end;
macro 'Plot Profile and Display Values';
var
count, ppv, ymin, ymax, i: integer;
scale: real;
unit: string;
begin
GetScale(scale, unit);
PlotProfile;
GetPlotData(count, ppv, ymin, ymax);
NewTextWindow('Plot Values', 150, 450);
for i := 0 to count -1 do
writeln(i / scale:1:3, ' ', PlotData[i]:1:3);
end;
macro 'Plot Radial Profiles… [R]';
var
x1,y1,x2,y2,pi,angle,delta:real;
LineWidth,i,nLines,radius,PlotWidth,PlotHeight:integer;
MinPlotWidth,hMargin,vMargin,PlotLeft,PlotTop:integer;
LeftMargin,RightMargin,TopMargin,BottomMargin:integer;
ImageWindow,PlotWindow:integer;
nPixels,mean,mode,min,max:real;
begin
RequiresVersion(1.54);
SaveState;
GetLine(x1,y1,x2,y2,LineWidth);
if x1<0 then begin
PutMessage('Please select a point by clicking with the line tool.');
exit;
end;
radius:=GetNumber('Radius:',20);
nLines:=GetNumber('Number of Lines:',8);
MinPlotWidth:=140;
pi:=3.14159;
delta:=2.0*pi/nLines;
angle:=0.0;
PlotWidth:=radius;
if PlotWidth<MinPlotWidth then PlotWidth:=MinPlotWidth;
PlotHeight:=0.4*PlotWidth;
SetPlotSize(PlotWidth,PlotHeight);
MakeOvalRoi(x1-radius,y1-radius,radius*2,radius*2);
Measure;
GetResults(nPixels,mean,mode,min,max);
min:=min-10;
if min<0 then min:=0;
max:=max+10;
if max>255 then max:=255;
SetPlotScale(cValue(min),cValue(max));
SetPlotLabels(false);
hMargin:=5;
vMargin:=5;
LeftMargin:=38;
TopMargin:=10;
RightMargin:=20;
BottomMargin:=20;
PlotLeft:=hMargin-LeftMargin;
PlotTop:=vMargin-TopMargin;
SetNewSize(PlotWidth+2*hMargin,PlotHeight*nLines);
SetForegroundColor(255);
SetBackgroundColor(0);
ImageWindow:=PicNumber;
MakeNewWindow('Plots');
PlotWindow:=PicNumber;
SelectPic(ImageWindow);
for i:=1 TO nLines do begin
x2:=x1+round(radius*cos(angle));
y2:=y1+round(radius*sin(angle));
MakeLineRoi(x1,y1,x2,y2);
PlotProfile;
Copy;
SelectPic(PlotWindow);
MakeRoi(PlotLeft,PlotTop,PlotWidth+LeftMargin+RightMargin,
PlotHeight+TopMargin+BottomMargin);
Paste;
DoOr;
PlotTop:=PlotTop+PlotHeight-1;
SelectPic(ImageWindow);
angle:=angle+delta;
end;
RestoreState;
end;
macro 'Radial Intensity Distibution…';
var
x1,y1,x2,y2,pi,angle,delta:real;
radius,ymin,ymax,sum:real;
i,j,LineWidth,nLines,count,ppv:integer;
begin
RequiresVersion(1.54);
SaveState;
GetLine(x1,y1,x2,y2,LineWidth);
if x1<0 then begin
PutMessage('Please select a point by clicking with the line tool.');
exit;
end;
radius:=GetNumber('Radius (pixels):',50);
nLines:=GetNumber('Number of Lines:',25);
for i:= 1 to radius do rUser1[i]:=0;
pi:=3.14159;
delta:=2.0*pi/nLines;
angle:=0.0;
for i:=1 to nLines do begin
x2:=x1+round(radius*cos(angle));
y2:=y1+round(radius*sin(angle));
MakeLineRoi(x1,y1,x2,y2);
GetPlotData(count,ppv,ymin,ymax);
for j:=1 to count do
rUser1[j]:=rUser1[j]+PlotData[j];
angle:=angle+delta;
end;
RestoreState;
DoColumnPlot(radius);
end;
macro 'Circular Profile Plot [C]';
var
radius,pi,angle,dx,dy,delta:real;
x1,y1,x2,y2:real;
npoints,i,value,LineWidth,x,y,px:integer;
begin
GetLine(x1,y1,x2,y2,LineWidth);
if x1< 0 then begin
PutMessage('Please select a point by clicking with the line tool.');
exit;
end;
x:=x1+(x2-x1)/2;
y:=y1+(y2-y1)/2;
radius:=sqrt(sqr(x2-x1)+sqr(y2-y1))/2;
if radius<3 then begin
PutMessage('The line selection must be longer than 5 pixels.');
exit;
end;
npoints:=radius*2;
pi:=3.14159;
delta:=2.0*pi/npoints;
angle:=0.0;
px:=0;
for i:=1 TO npoints do begin
dx:=round(radius*cos(angle));
dy:=round(radius*sin(angle));
value:=GetPixel(x+dx,y+dy);
PutPixel(x+dx,y+dy,255);
PutPixel(px,0,value);
px:=px+1;
angle:=angle+delta;
end;
MakeLineRoi(0,0,npoints,0);
PlotProfile;
KillRoi;
end;
macro 'Export Profile Plots…';
var
y,yInc,width,height,n:integer;
begin
yInc:=GetNumber('Y Increment:',10);
GetPicSize(width,height);
y:=0;
n:=0;
SetExport('Plot Values');
repeat
MakeLineRoi(0,y,width-1,y);
PlotProfile;
Export('PLOT',n:4);
n:=n+1;
y:=y+yInc;
until y>=height;
end;
procedure PlotMeans;
{Plots the mean column in the Results table.}
var
xmin,xmax,ymin,ymax,i,xscale,yscale:real;
width,height,margin,pwidth,pheight:integer;
y,pbottom:integer;
begin
margin:=40;
width:=500;
height:=300;
ymax:=-999999;
ymin:=999999;
for i:=1 to rCount do begin
y:=rMean[i];
if y>ymax then ymax:=y;
if y<ymin then ymin:=y;
end;
xmin:=0;
xmax:=rCount-1;
SetNewSize(width,height);
SetForeground(255);
SetBackground(0);
MakeNewWindow('Z-Axis Profile Plot');
pwidth:=width-2*margin;
pheight:=height-2*margin;
pbottom:=margin+pheight;
xscale:=pwidth/(xmax-xmin);
yscale:=pheight/(ymax-ymin);
SetForeground(255);
SetBackground(0);
SetLineWidth(1);
MoveTo(margin,pbottom-(rMean[1]-ymin)*yscale);
for i:=2 to rCount do
LineTo(margin+(i-1)*xscale,pbottom-(rMean[i]-ymin)*yscale);
MoveTo(margin,pbottom);
LineTo(margin+pwidth,pbottom);
MoveTo(margin,margin);
LineTo(margin,margin+pheight);
SetFont('Geneva');
SetFontSize(9);
SetText('Centered');
MoveTo(margin+4,margin+pheight+12);
writeln(xmin:1:2);
MoveTo(margin+pwidth,margin+pheight+12);
writeln(xmax:1:2);
SetText('Right Justified');
MoveTo(margin-2,margin+pheight-5);
writeln(ymin:1:2);
MoveTo(margin-2,margin);
writeln(ymax:1:2);
end;
macro 'Plot Z-Axis Profile [Z]';
{Plots the average density of an roi through a stack.}
var
left,top,width,height,i:integer;
begin
if (nPics=0) or (nSlices=0) then begin
PutMessage('This macro requires a stack.');
exit;
end;
GetRoi(left,top,width,height);
if width=0 then begin
PutMessage('Selection required.');
exit;
end;
ResetCounter;
{SetOptions('Mean');}
for i:= 1 to nSlices do begin
SelectSlice(i);
Measure;
end;
PlotMeans;
end;
macro 'Plot XYZ';
{
Plots X-Y coordinate points with an optional intensity(Z). Values are read from
a 2 or 3 column tab-delimited text file. Data must be scaled as follows:
0<=X<width; 0<=Y<height; 0<=Z<=255.
}
var
width,height:integer;
begin
SaveState;
width:=500;
height:=500;
SetNewSize(width,height);
SetForeground(255);
SetBackground(0);
MakeNewWindow('Plot');
PlotXYZ;
RestoreState;
end;
macro 'Draw Fitted Ellipse in White';
var
left,top,width,height:real;
begin
GetRoi(left,top,width,height);
if width=0 then begin
PutMessage('This macro requires a selection.');
exit;
end;
SetOptions('Area; Mean; X-Y Center');
Measure;
SetOption; MarkSelection;
KillRoi;
SelectAll;
KillRoi;
end;
macro 'Draw Calibration Bar [B]';
{Generates a vertical calibration bar with labels.}
var
top,left,width,height,nLabels,i:integer;
vloc,fwidth,digits,value:integer;
begin
SaveState;
GetRoi(left,top,width,height);
if width=0 then begin
PutMessage('This macro requires a selection.');
exit;
end;
if width>height then begin
PutMessage('Selection must be vertically oriented.');
exit;
end;
nLabels:=round(height/25);
if nLabels<2 then nLabels:=2;
SetFontSize(9);
SetFont('Monaco');
SetText('Left Justified, With Background');
DrawScale;
{FlipVertical;}
KillRoi;
SetForeground(255); {black}
SetBackground(0); {white}
if calibrated then begin
fwidth:=7;
digits:=4;
end else begin
fwidth:=3;
digits:=0;
end;
vloc:=top;
for i:=0 to nLabels-1 do begin
vloc:=top+round(i*((height-1)/(nLabels-1)));
if vloc>=(top+height) then vloc:=top+height-1;
MoveTo(left+width+4,vloc+3);
value:=cvalue(GetPixel(left,vloc));
Write(value:fwidth:digits);
vloc:=vloc+round(height/(nLabels-1));
end;
RestoreRoi;
SetForeground(0); {white}
InsetRoi(-1);
DrawBoundary;
KillRoi;
RestoreState;
end;
macro 'Show Polar Coordiates [P]';
{Returns polar coordinates of a point selected with the mouse, using centre
of the image as 0,0. Data are displayed in the Info window as distance from
centre of image, and angle in degrees measured clockwise, where 0 is the
12 o'clock position}
var
Wide, High,x2,y2:integer;
x1,y1,D,Theta,rad:real;
begin
rad:=180/3.14159265;
InvertY(true);
GetPicSize(Wide,High);
SetCursor('cross');
repeat
GetMouse(x2,y2);
x1:=Wide/2;
y1:=High/2;
y2:=High-y2
if (x1=x2) and (y1=y2) then begin
D:=0;
Theta:=0;
end;
if (y1<>y2) then begin
D:= sqrt((sqr(x2-x1))+ (sqr(y2-y1)));
Theta:=rad*(arctan((x2-x1)/(y2-y1)));
end;
if (y2<y1) then begin
Theta:=180 + Theta;
end;
if (x2<x1) and (y2>y1) then begin
Theta:=360+Theta;
end;
ShowMessage('Distance: ',D:5:1'\''Angle: ',Theta:5:1);
Wait(0.2);
until button;
end;
macro 'Record XY [X]';
{Records the X-Y Coordinates of each pixel in the perimeter
of a particle (selected with the wand) and saves the data to a
comma-delimited text file}
var
i,w,h:real;
xbase,ybase,width,height,RoiWidth,RoiHeight:real
x,y,xmax,ymax:real
begin
GetPicSize(width,height);
GetRoi(xbase,ybase,RoiWidth,RoiHeight);
if (RoiWidth=0) or (nCoordinates=0) then begin
PutMessage('Select a particle with the wand.');
exit;
end;
InvertY(false);
NewTextWindow('XY Data',150,400);
for i:=1 to nCoordinates do
Writeln(i,',',xCoordinates[i]+xbase:5:0,',',Height-yCoordinates[i]-ybase:5:0);
end;
procedure WriteReal(r:real);
{Writes a real number using scientific notation.}
var
e: integer;
begin
e := 0;
while r >= 10 do begin
r := r / 10;
e := e + 1;
end;
while r < 1 do begin
r := r * 10;
e := e - 1;
end;
write(r:8:6);
if e >= 0 then
write('e+')
else begin
e := -e;
write('e-')
end;
if e <10 then
write('0');
write(e:1);
end;
macro 'Write Real Test...';
var
r: real;
begin
r := GetNumber('Enter a real number:', 1.234);
NewTextWindow('Output');
WriteReal(r);
end;
macro 'Make Image Correlation Plot...';
{Generates an XY plot indicating how well correlated two images are.
It uses the z-value of a given pixel in a certain slice as the x-coordinate;
z-value of the corresponding pixel in another slice as the y-coordinate.
These are plotted into a new window to give a scatter plot. The
percentage done is shown in the Info window.}
var
xmin, xmax, ymin, ymax, xscale, yscale, Percent: real;
xslice, yslice, nPixels, ticks: integer;
width, height, x, y, xvalue, yvalue, Pointvalue: integer;
wide, high, StackID, PlotID, margin, ticksize: integer;
time: real;
begin
if nSlices=0 then begin
beep;
PutMessage('This macro requires a stack.');
exit
end;
SaveState;
InvertY(true);
KillRoi;
GetPicSize(wide, high);
nPixels:=wide * high;
Measure;
StackID := PidNumber;
xslice := GetNumber('Slice to plot on the x-axis:', 1);
yslice := GetNumber('Slice to plot on the y-axis:', 2);
width := 256;
height := 256;
SetNewSize(width,height);
SetForeground(255);
SetBackground(0);
MakeNewWindow('Plot');
InvertY(true);
PlotID := PicNumber;
SelectPic(StackID);
SetCursor('watch');
ticks := TickCount;
for y := 0 to high - 1 do begin
for x := 0 to wide - 1 do begin
ChoosePic(StackID);
ChooseSlice(xslice);
xvalue:=GetPixel(x, y); {ie z-value of pixel (x,y) on one slice}
ChooseSlice(yslice);
yvalue:=GetPixel(x, y); {ie z-value of same pixel on other slice}
ChoosePic(PlotID);
Pointvalue := GetPixel(xvalue, 255 - yvalue);
if PointValue < 254
then PointValue:=PointValue+1;
PutPixel(xvalue, 255 - yvalue, PointValue);
end; {for x...}
if (y mod 10) = 0
then ShowMessage((y / high) * 100:2:0, '% done');
end; {for y...}
time := (TickCount-ticks) / 60;
ShowMessage(nPixels:1, ' pixels\', time:1:2, ' seconds\',
nPixels/time:1:0, ' pixels/second');
SelectPic(StackID);
SelectSlice(xSlice);
SelectPic(PlotID);
SelectAll;
EnhanceContrast;
ApplyLut;
SelectAll;
Copy;
Dispose;
margin := 75;
ticksize := 6;
SetNewSize(width + (2 * margin), height + (2 * margin));
SetForeground(255);
SetBackground(0);
MakeNewWindow('Correlation Plot');
SetFont('Geneva');
SetFontSize(9);
InvertY(true);
MakeRoi(margin, margin, 256, 256);
Paste;
MakeRoi(margin - 1, margin - 1, 258, 258);
SetLinewidth(1);
DrawBoundary;
KillRoi;
MoveTo(margin, margin + 255);
LineTo(margin, margin + 255 + ticksize);
MoveTo(margin + 50, margin + 256);
LineTo(margin + 50, margin + 256 + ticksize);
MoveTo(margin + 100, margin + 256);
LineTo(margin + 100, margin + 256 + ticksize);
MoveTo(margin +150, margin + 256);
LineTo(margin + 150, margin + 256 + ticksize);
MoveTo(margin + 200, margin + 256);
LineTo(margin + 200, margin + 256 + ticksize);
MoveTo(margin + 255, margin + 256);
LineTo(margin + 255, margin + 256 + ticksize);
MoveTo(margin - 1, margin + 255);
LineTo(margin - ticksize, margin + 255);
MoveTo(margin - 1, margin + 206);
LineTo(margin - ticksize, margin + 206);
MoveTo(margin -1 , margin + 156);
LineTo(margin - ticksize, margin + 156);
MoveTo(margin - 1, margin + 106);
LineTo(margin - ticksize, margin + 106);
MoveTo(margin - 1, margin + 56);
LineTo(margin - ticksize, margin + 56);
MoveTo(margin - 1, margin);
LineTo(margin - ticksize, margin);
MoveTo(margin - 25, margin);
Writeln('255');
MoveTo(margin - 25, margin + 56);
Writeln('200');
MoveTo(margin - 25, margin + 156);
Writeln('100');
MoveTo(margin - 14, margin + 256);
Writeln('0');
MoveTo(margin - 2, margin + 270);
Writeln('0');
MoveTo(margin + 92, margin + 270);
Writeln('100');
MoveTo(margin + 192, margin + 270);
Writeln('200');
MoveTo(margin + 248, margin + 270);
Writeln('255');
MoveTo(margin + 70, margin + 290);
Writeln('Z-value on slice', xslice:1);
MoveTo(margin - 65, margin + 100);
Writeln('Z-value');
MoveTo(margin - 65, margin + 115);
Writeln('on slice', yslice:1);
RestoreState;
end;